home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / perl / prlbkxmp.lha / ch6 / server < prev    next >
Text File  |  1991-01-08  |  982b  |  51 lines

  1. #!/usr/bin/perl
  2.  
  3. ($port) = @ARGV;
  4. $port = 2345 unless $port;
  5.  
  6. $AF_INET = 2;
  7. $SOCK_STREAM = 1;
  8.  
  9. $sockaddr = 'S n a4 x8';
  10.  
  11. ($name, $aliases, $proto) = getprotobyname('tcp');
  12. if ($port !~ /^\d+$/) {
  13.     ($name, $aliases, $port) = getservbyport($port, 'tcp');
  14. }
  15.  
  16. print "Port = $port\n";
  17.  
  18. $this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");
  19.  
  20. select(NS); $| = 1; select(stdout);
  21.  
  22. socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
  23. bind(S,$this) || die "bind: $!";
  24. listen(S,5) || die "connect: $!";
  25.  
  26. select(S); $| = 1; select(stdout);
  27.  
  28. $con = 0;
  29. print "Listening for connection 1....\n";
  30. for(;;) {
  31.     ($addr = accept(NS,S)) || die $!;
  32.  
  33.     $con++;
  34.     if (($child[$con] = fork()) == 0) {
  35.     print "accept ok\n";
  36.  
  37.     ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
  38.     @inetaddr = unpack('C4',$inetaddr);
  39.     print "$con: $af $port @inetaddr\n";
  40.  
  41.     while (<NS>) {
  42.         print "$con: $_";
  43.     }
  44.     close(NS);
  45.     exit;
  46.     }
  47.     close(NS);
  48.  
  49.     printf("Listening for connection %d\n",$con+1);
  50. }
  51.